\documentclass{article}
\usepackage{fancyhdr,float,palatino,setspace,amsmath}
\usepackage[hidelinks]{hyperref}

\pagestyle{fancy}
\fancyhf{} % clear existing header/footer entries
% Place Page X of Y on the right-hand
% side of the header
\fancyhead[R]{Page \thepage \hspace{1pt}}

\author{Brian J. Gaines}
\title{Replication Code: Life-or-Death Framing of Public-Health Policy in a Pandemic}
\begin{document}
\maketitle

\section*{Read Me First}

The R code below creates all tables, figures, or calculations reported in the paper, employing the data in \texttt{jeps.bjg.sav}, a subset of variables from the UI module of the 2020 CES. In each \texttt{R} chunk, echo is set to true. Quotations are from the article, and results are presented in the same order as the article.

``Figure~ 1 shows that subjects' choices were little affected by the frames, in contrast to the original study and most replications. The figure shows proportions who chose the risk-averse option given each frame, and, for comparison, the same quantities in the original data (gray crosses) and Druckman's replication (gray circles), with 95-percent confidence intervals.'' 

R code to draw Figure 1 from the article is immediately below. 

<<prepfig1,echo=T,results='asis',warning=F,message=F>>=
rm(list=ls())
load(file="~/Dropbox/CCES20/jeps.bjg.sav")

# weighted
T1<-matrix(0,nrow=3,ncol=2)

# A. gains, C. both, B. losses
ADT<-c("UIL368A","UIL368C","UIL368B") 
RO1<-c("Option 1","Option 2")
SYS<-c("C1","C2","C3")

for(r in 1:3){
  for(c in 1:2){
T1[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                              &ccdat$UIL368==RO1[c]],na.rm=T)
      }
}

T1p<-prop.table(T1,1)
@

\pagebreak

\begin{figure}[H]
\caption{Replication versus Original}
\label{fig:repvoth}
<<fig1,echo=T,results='asis'>>==
# Figure 1
plot(c(1,2,3),T1p[,1],ylim=c(0,1),xaxt='n',
     pch=20,xlim=c(0.5,3.5),
     ylab="Proportion Selecting Certain Option",
      xlab="Frame")
lines(c(1,1),prop.test(T1[1,1],sum(T1[1,]))$conf.int)
lines(c(2,2),prop.test(T1[2,1],sum(T1[2,]))$conf.int)
lines(c(3,3),prop.test(T1[3,1],sum(T1[3,]))$conf.int)
text(1,0.06,"gains",cex=.9)
text(2,0.06,"both",cex=.9)
text(3,0.06,"losses",cex=.9)

# Druckman
points(c(1.1,2.1,3.1),c(47/69,75/172,18/79),pch="o",col="grey")
lines(c(1.1,1.1),prop.test(47,69)$conf.int,col="grey")
lines(c(2.1,2.1),prop.test(75,172)$conf.int,col="grey")
lines(c(3.1,3.1),prop.test(18,79)$conf.int,col="grey")

# T&K 1981 
points(c(1.2,3.2),c(109/152,34/155),pch="+",col="grey")
lines(c(1.2,1.2),prop.test(109,152)$conf.int,pch="-",col="grey")
lines(c(3.2,3.2),prop.test(34,155)$conf.int,pch="-",col="grey")
@
\end{figure}

\pagebreak

``Approximate p-values for difference-of-proportions tests between gains and both, gains and losses, and both and losses are 0.03, 0.23, and 0, respectively.'' 

Code to compute those values follows below.

<<apptab2,echo=T,results='asis',message=F>>=
library(xtable)
AT2<-round(T1p,2)
wNs<-c(sum(T1[1,]),sum(T1[2,]),sum(T1[3,]))
AT2<-cbind(AT2,round(wNs,0))
colnames(AT2)<-c("certain","probabilistic","N")
row.names(AT2)<-c("gains","both","losses")
xtable(AT2,caption = "Weighted Responses by Frame", 
       label = "tab:tabA2",digits=c(0,2,2,0))
@

A test of equality between the proportions in the gains and both frames, again employing a Yates continuity correction, yields a $\chi^2$ statistic of
<<chi1w,echo=T,results='asis'>>=
cat(round(prop.test(c(T1[1:2,1]),c(wNs[1:2]))$stat,2)[1])
@
with an associated $p$ value of
<<chi1wp,echo=T,results='asis'>>=
cat(paste(round(prop.test(c(T1[1:2,1]),c(wNs[1:2]))$p.value,2)),".",sep="")
@
 The same statistics for comparison of both and losses are $\chi^2=$
<<chi2w,echo=T,results='asis'>>=
cat(round(prop.test(c(T1[2:3,1]),c(wNs[2:3]))$stat,2)[1])
@
and $p=$
<<chi2wp,echo=T,results='asis'>>=
cat(paste(round(prop.test(c(T1[2:3,1]),c(wNs[2:3]))$p.value,2)),",",sep="")
@
 respectively.
 
Testing for equality between gains and losses yields $\chi^2=$
<<chi3w,echo=T,results='asis'>>=
cat(paste(round(prop.test(c(T1[1,1],T1[3,1]),c(wNs[1],wNs[3]))$stat,2)),".",sep="")
@
and $p=$
<<chi3wp,echo=T,results='asis'>>=
cat(paste((round(prop.test(c(T1[1,1],T1[3,1]),c(wNs[1],wNs[3]))$p.value,2)),".",sep=""))
@
 

For a continuous measure of evidence, Bayes factors for testing the equality of the proportions in the three versions are: 
<<computeBF,echo=T,results='asis',warning=F,message=F>>=
#install.packages("abtest")
library(abtest)
data.gl <- list(y1 = round(T1[1,1],0), n1 = round(sum(T1[1,]),0),
                y2 = round(T1[3,1],0), n2 = round(sum(T1[3,]),0))
data.gb <- list(y1 = round(T1[1,1],0), n1 = round(sum(T1[1,]),0),
                y2 = round(T1[2,1],0), n2 = round(sum(T1[2,]),0))
data.lb <- list(y1 = round(T1[3,1],0), n1 = round(sum(T1[3,]),0),
                y2 = round(T1[2,1],0), n2 = round(sum(T1[2,]),0))

gl <- ab_test(data = data.gl)

gb <- ab_test(data = data.gb)

lb <- ab_test(data = data.lb)

txt<-paste(round(as.numeric(gb$bf[1]),2),", ",round(as.numeric(gl$bf[1]),2),
      ", and ",round(as.numeric(lb$bf[1]),2),sep="")
cat(txt)
@
, comparing gains to both, gains to losses, and losses to both, respectively.

\section*{System Justification}

Footnote 4 says, ``As part of a distinct experiment, subjects were randomly assigned to one of three conditions relating to ``system justification''. I ignore these, and the Appendix includes supporting analysis.'' That analysis is below.

The respondents were completing the CES and were, accordingly, exposed to a large number of questions. Within the module, an experiment distinct from our ``Asian Disease'' replication exposed the respondents to one of three distinct openings, to place them in a mindset of system-threat, system-affirmation, or neither (as a control). I checked whether these treatments appeared to affect the ADE responses.

The ``threat'' item was the following.
\begin{quote}
These days, many people in the United States feel disappointed with the nation’s condition. Many citizens feel that the country has reached a low point in terms of social, economic, and political factors. It seems that many countries are enjoying better social, economic, and political conditions than the U.S. More and more Americans express a willingness to leave the United States and immigrate to other nations.
\end{quote}

The ``affirming'' introduction read as follows.
\begin{quote}
These days, despite the difficulties the nation is facing, many people in the United States feel safer and more secure relative to the past. Many citizens feel that the country is relatively stable in terms of social, economic, and political factors. It seems that compared with many countries in the world the social, economic, and political conditions in the U.S. are relatively good. Very few Americans express a willingness to leave the United States and immigrate to other nations.
\end{quote}

A chi-squared test on distributions of the chosen mitigation programs across these frames supports independence, with $\chi^2(2)=$

<<systemT,echo=T,results='asis'>>=
# System Threat/Affirming
# C1 control
# C2 (Threat) These days, many people in the United States feel disappointed...
# C3 (Affirm) These days, despite the difficulties...

sysc<-subset(ccdat,ccdat$UIL301_treat=="C1")
syst<-subset(ccdat,ccdat$UIL301_treat=="C2")
sysa<-subset(ccdat,ccdat$UIL301_treat=="C3")

T1sc<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1sc[r,c]<-sum(sysc$teamweight[sysc$UIL368_treat==ADT[r]
                              &sysc$UIL368==RO1[c]],na.rm=T)
      }
}
T1scp<-prop.table(T1sc,1)

T1st<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1st[r,c]<-sum(syst$teamweight[syst$UIL368_treat==ADT[r]
                              &syst$UIL368==RO1[c]],na.rm=T)
      }
}
T1stp<-prop.table(T1st,1)


T1sa<-matrix(0,nrow=3,ncol=2)
for(r in 1:3){
  for(c in 1:2){
T1sa[r,c]<-sum(sysa$teamweight[sysa$UIL368_treat==ADT[r]
                              &sysa$UIL368==RO1[c]],na.rm=T)
      }
}
T1sap<-prop.table(T1sa,1)

# check for system T only
T3<-matrix(0,ncol=2,nrow=3)
T3[1,1]<-sum(T1sc[,1])
T3[1,2]<-sum(T1sc[,2])
T3[2,1]<-sum(T1st[,1])
T3[2,2]<-sum(T1st[,2])
T3[3,1]<-sum(T1sa[,1])
T3[3,2]<-sum(T1sa[,2])
cat(chisq.test(T3)$statistic)
@
with a $p$-value of
<<pv,echo=T,results='asis'>>=
cat(paste(round(chisq.test(T3)$p.value,2)),".",sep="")
@


If we, instead, examine the overall average treatment effects separately for each systems frame, differences are slight, as the figure below demonstrates.

\pagebreak

\begin{figure}[H]
\label{fig:sysjust}
\caption{Choices By Frames}
<<apfig,echo=T,results='asis',message=F>>=
par(mfrow=c(1,1))
plot(c(1,2,3),T1scp[,1],ylim=c(0,1),xaxt='n',
     pch=20,xlim=c(0.5,3.5),ylab="Proportion Selecting Risk-Averse Option",
      xlab="ADE frame")
lines(c(1,1),prop.test(T1sc[1,1],sum(T1sc[1,]))$conf.int)
lines(c(2,2),prop.test(T1sc[2,1],sum(T1sc[2,]))$conf.int)
lines(c(3,3),prop.test(T1sc[3,1],sum(T1sc[3,]))$conf.int)
text(1,0.05,"gains",cex=.9); text(2,0.05,"both",cex=.9);text(3,0.05,"losses",cex=.9)

points(c(1.1,2.1,3.1),T1stp[,1],col="red")
lines(c(1.1,1.1),prop.test(T1st[1,1],sum(T1st[1,]))$conf.int,
      col="red")
lines(c(2.1,2.1),prop.test(T1st[2,1],sum(T1st[2,]))$conf.int,
      col="red")
lines(c(3.1,3.1),prop.test(T1st[3,1],
                        sum(T1st[3,]))$conf.int,col="red")

points(c(1.2,2.2,3.2),T1sap[,1],col="blue")
lines(c(1.2,1.2),prop.test(T1sa[1,1],sum(T1sa[1,]))$conf.int,
      col="blue")
lines(c(2.2,2.2),prop.test(T1sa[2,1],sum(T1sa[2,]))$conf.int,
      col="blue")
lines(c(3.2,3.2),prop.test(T1sa[3,1],sum(T1sa[3,]))$conf.int,
      col="blue")

text(.9,.95,"control"); text(1.2,.91,"threat",col="red"); text(1.4,.87,"affirm",col="blue")
@
\end{figure}

\pagebreak

\section*{Framing Effects By Personal Experience with Covid}

``Separating respondents according to whether or not they reported close encounters with actual COVID infection yielded no appreciable difference. For the 476 (unweighted) who reported either having had COVID themselves or that a friend, family member, or co-worker had, proportions were almost identical to those shown in Figure 1, as were those for the 524 (unweighted) reporting no such direct contact with the disease. Tables in the Appendix document the similarity.''


Program choices were very similar for those who reported knowing someone (friend, co-worker or family member) who had had COVID or having had it themselves and for those who did not. Weighted proportions are shown in Tables A3 and A4 below. 


<<apptab3,echo=T,results='asis',message=F>>=
library(xtable)
# separate by knowing anyone (incl self)
#  diagnosed w Covid
come<-2-as.numeric(ccdat$CC20_309a_1)
cofam<-2-as.numeric(ccdat$CC20_309a_2)
cofrd<-2-as.numeric(ccdat$CC20_309a_3)
cowrk<-2-as.numeric(ccdat$CC20_309a_4)
coany<-as.numeric(come+cofam+cofrd+cowrk>0)
cono<-2-as.numeric(ccdat$CC20_309a_5)
# no inconsistency!
#table(coany,cono)


Tk.y<-matrix(0,nrow=3,ncol=2)
Tk.n<-matrix(0,nrow=3,ncol=2)

for(r in 1:3){
  for(c in 1:2){
Tk.y[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &cono==0],na.rm=T)
Tk.n[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &cono==1],na.rm=T)
      }
}

T3ap<-prop.table(Tk.y,1)
AT3a<-round(T3ap,2)
wNs3a<-c(sum(Tk.y[1,]),sum(Tk.y[2,]),sum(Tk.y[3,]))
AT3a<-cbind(AT3a,round(wNs3a,0))
colnames(AT3a)<-c("certain","probabilistic","N")
row.names(AT3a)<-c("gains","both","losses")
xtable(AT3a,caption = "Weighted Responses by Frame, with COVID-positive Acquaintances", 
       label = "tab:tabA3",digits=c(0,2,2,0))

T4p<-prop.table(Tk.n,1)
AT4<-round(T4p,2)
wNs4<-c(sum(Tk.n[1,]),sum(Tk.n[2,]),sum(Tk.n[3,]))
AT4<-cbind(AT4,round(wNs4,0))
colnames(AT4)<-c("certain","probabilistic","N")
row.names(AT4)<-c("gains","both","losses")
xtable(AT4,caption = "Weighted Responses by Frame, w/o COVID-pos. Acquaintances", 
       label = "tab:tabA3b",digits=c(0,2,2,0))
@

``Given the significance of mortality to the ADE, brushes with death might better proxy motivation to wrestle with the choice. Only half of the sample was queried about connections to COVID deaths, and 134 individuals said that a friend, family member, or co-worker had died from the disease, while 353 said the opposite. The latter group again displayed a quite small gap in proportions choosing the certain option given gains frames (0.54) or losses frames (0.48). Against expectation, those reporting proximity to COVID deaths were a somewhat better match to the original ADE subjects, with a corresponding gap of about 0.20 (0.66-0.46). However, reduced sample size conspired against statistical significance ($p\approx0.13$).''

Tables A5 and A6 show weighted proportions according to subjects' self-reported experience of knowing someone who died of COVID.

<<anotherchunk,echo=F,results='asis'>>==
# separate effects by reporting having had family, friend or co-worker
# die of Covid
# seeming errors in not-selected
# s+not-s do not sum to anywhere near 500
# except for "no" (b_4)
codifam<-1-as.numeric(as.numeric(ccdat$CC20_309b_4)>0)
codifrd<-codifam
codiwrk<-codifam
codifam[as.numeric(ccdat$CC20_309b_1)==1]<-1
codifrd[as.numeric(ccdat$CC20_309b_2)==1]<-1
codiwrk[as.numeric(ccdat$CC20_309b_3)==1]<-1
codiany<-as.numeric((codifam+codifrd+codiwrk)>0)
codino<-2-as.numeric(ccdat$CC20_309b_4)

Td.y<-matrix(0,nrow=3,ncol=2)
Td.n<-matrix(0,nrow=3,ncol=2)

for(r in 1:3){
  for(c in 1:2){
Td.y[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &codino==0],na.rm=T)
Td.n[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                                &ccdat$UIL368==RO1[c]
                                &codino==1],na.rm=T)
      }
}

T5p<-prop.table(Td.y,1)
AT5<-round(T5p,2)
wNs5<-c(sum(Td.y[1,]),sum(Td.y[2,]),sum(Td.y[3,]))
AT5<-cbind(AT5,round(wNs5,0))
colnames(AT5)<-c("certain","probabilistic","N")
row.names(AT5)<-c("gains","both","losses")
xtable(AT5,caption = "Weighted Responses by Frame, Acquaintances died from COVID", 
       label = "tab:tabA5",digits=c(0,2,2,0))

T6p<-prop.table(Td.n,1)
AT6<-round(T6p,2)
wNs6<-c(sum(Td.n[1,]),sum(Td.n[2,]),sum(Td.n[3,]))
AT6<-cbind(AT6,round(wNs6,0))
colnames(AT6)<-c("certain","probabilistic","N")
row.names(AT6)<-c("gains","both","losses")
xtable(AT6,caption = "Weighted Responses by Frame, No Acquaintances died from COVID", 
       label = "tab:tabA6",digits=c(0,2,2,0))
@

<<pvalue.death,results='asis',echo=T>>==
prop.test(c(Td.y[1,1],Td.y[3,1]),c(sum(Td.y[1,1:2]),sum(Td.y[3,1:2])))$p.value
@


``..with a roughly 14-percentage-point gap in preference for the certain option, comparing gains-frame to losses-frame treatments, than did the non-worriers, whose gap was -3 percentage points. But conditioning on sleep deprivation complicates expectations, and the concomitant small $N$s again prevented statistical significance.''

<<worry,echo=T,results='asis'>>==
# separate by worry

TW.w<-matrix(0,nrow=3,ncol=2)
TW.n<-matrix(0,nrow=3,ncol=2)

for(r in 1:3){
  for(c in 1:2){
TW.w[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                              &ccdat$UIL368==RO1[c]
                              &as.numeric(ccdat$UIL414_7)==1]
                              ,na.rm=T)
TW.n[r,c]<-sum(ccdat$teamweight[ccdat$UIL368_treat==ADT[r]
                              &ccdat$UIL368==RO1[c]
                              &as.numeric(ccdat$UIL414_7)==2]
                              ,na.rm=T)
      }
}

T7p<-prop.table(TW.n,1)
AT7<-round(T7p,2)
wNs7<-c(sum(TW.n[1,]),sum(TW.n[2,]),sum(TW.n[3,]))
AT7<-cbind(AT7,round(wNs7,0))
colnames(AT7)<-c("certain","probabilistic","N")
row.names(AT7)<-c("gains","both","losses")
xtable(AT7,caption = "Weighted Responses by Frame, not worried by COVID", 
       label = "tab:tabA7",digits=c(0,2,2,0))

T8p<-prop.table(TW.w,1)
AT8<-round(T8p,2)
wNs8<-c(sum(TW.w[1,]),sum(TW.w[2,]),sum(TW.w[3,]))
AT8<-cbind(AT8,round(wNs8,0))
colnames(AT8)<-c("certain","probabilistic","N")
row.names(AT8)<-c("gains","both","losses")
xtable(AT8,caption = "Weighted Responses by Frame, worried by COVID", 
       label = "tab:tabA8",digits=c(0,2,2,0))
@

<<pvalue.worry,results='asis',echo=T>>==
prop.test(c(TW.w[1,1],TW.w[3,1]),c(sum(TW.w[1,1:2]),sum(TW.w[3,1:2])))$p.value
@

\pagebreak

\vspace{6pt}
\section*{Other Recent Replications}

<<allstudies,echo=T,results='asis'>>=
# us,..est'd midpt date for CES
h0<-as.Date("10/15/2020",format="%m/%d/%Y")
ptest0<-T1p[1,1]-T1p[3,1]

# manylabs (from Rachev et al Supp 2)
TML<-matrix(c(1974,1200,1038,2059),nrow=2,byrow=T)
ptestML<-TML[1,1]/sum(TML[1,])-TML[2,1]/sum(TML[2,])
# compute 95%CI
ML95CI<-prop.test(x=TML[,1],n=c(sum(TML[1,]),sum(TML[2,])),conf.level=0.95)$conf.int

### other studies pt ests and CIs
# a. (SSQ Wolaver & Doces)
# Feb 13-20 & Dec 3-7, 2020
# n=764
# n.disease=252
# n.terrorism=253
# n.corruption=259 (scale of $ dichotomized)

# from emails
# disease 44/130=0.338=p(cert|loss)
#         72/122=0.590=p(cert|gain)
# terrm   38/122=0.311=p(cert|loss)
#         98/131=0.748=p(cert|gain)
# corrp   46/134=0.343=p(cert|loss)
#         82/125=0.656=p(cert|gain)
# Dec.   202/608=0.332=p(cert|loss)
#        371/591=0.628=p(cert|gain)

ha1<-as.Date("02/13/2020",format="%m/%d/%Y")
ha2<-as.Date("02/20/2020",format="%m/%d/%Y")
ha3<-as.Date("12/5/2020",format="%m/%d/%Y")

Ta1<-prop.test(x=c(72,44),n=c(122,130))
ptesta1<-Ta1$estimate[1]-Ta1$estimate[2]
Ta2<-prop.test(x=c(98,38),n=c(131,122))
ptesta2<-Ta2$estimate[1]-Ta2$estimate[2]
Ta3<-prop.test(x=c(371,202),n=c(591,608))
ptesta3<-Ta3$estimate[1]-Ta3$estimate[2]

# b. Hameleers, March 16, 2020
# Table 1
# US.g 80.9% (n=277), US.l	47.8% (n=276)
# Nth.g 85.6% (n=278)  Nth.l	41.9% (n=279)
hb<-as.Date("03/16/2020",format="%m/%d/%Y")
f1ug<-round(.809*277,0)
f1ng<-round(.856*278,0)
f1ul<-round(.478*276,0)
f1nl<-round(.419*279,0)
ptestb1<- 0.809-0.478
ptestb2<- 0.856-0.419

@

\pagebreak

More (tedious) R chunk below.

<<more values,echo=T,results='asis'>>=
# c. Otterbeing et al., April 2020
# N=743 (57 dropped)
# numbers from text, section 4.1.1, p.4
# n.a=362 AD, risky by 70.3% - 30.6% +
# n.b=381 C19, risky by 67.4% - 22.9% +
hc<-as.Date("04/15/2020",format="%m/%d/%Y")
ptestc1<-0.703-0.306
ptestc2<-0.674-0.229

#  even splits of 362 and 381
f2ag<-round(.703*181,0) 
f2bg<-round(.674*191,0)
f2al<-round(.303*181,0)
f2bl<-round(.229*190,0)
# d. Olmastroni et al. 
# April 24-28, 2020
hd<-as.Date("04/28/2020",format="%m/%d/%Y")
ptestd1<-.31 # .59-.28, n+=379, n-=
ptestd2<-.11 # .53-.42
neg<-111+191+77
f3eg<-round(.53*neg,0)
nel<-118+190+90
f3el<-round(.42*nel,0)
nhg<-124+190+75
f3hg<-round(.59*nhg,0)
nhl<-114+193+89  
f3hl<-round(.28*nhl,0)

# Rachev et al., March to May 2020 
he<-as.Date("05/15/2020",format="%m/%d/%Y")
# Grisk,Gnot,Lrisk,Lnot
# table S2.1
T4<-c(29651,14692,15919,27919)
pteste<-T4[1]/sum(T4[1:2])-T4[3]/sum(T4[3:4])

# f. Im & Chen, Mar 30-May30, 2020
hf<-as.Date("05/30/2020",format="%m/%d/%Y")
# Gain.risk,Gain.certain,Loss.risk,L.certain
T6<-c(17264,34313,32649,18604)
ptestf<-T6[2]/sum(T6[1:2])-T6[4]/sum(T6[3:4])
@

\pagebreak

Finally, creating the figure.

\begin{figure}
\caption{Pandemic ADE Replication Results}
\label{fig:othreps}
<<drawthefig,echo=T,results='asis'>>=
# figure
plot(c(h0,ha1,ha2,hb+1,hb-1,hc-1,hc+1,hd-1,hd+1,he,hf,ha3),
     c(ptest0,ptesta1,ptesta2,ptestb1,ptestb2,ptestc1,
       ptestc2,ptestd1,ptestd2,pteste,ptestf,ptesta3),
       ylab="p(certain | gains)-p(certain | losses)",xlab="2020",ylim=c(-.03,.6))
text(as.numeric(as.Date(h0))-50,.5,"TK");text(as.numeric(as.Date(h0)-55),.285,"ML95CI")
abline(h=0,lty="dotted");abline(h=.5,lty="dashed"); abline(h=ML95CI[1],lty="dashed");abline(h=ML95CI[2],lty="dashed")
text(ha2,-0.015,"a");text(ha3,-0.015,"a");text(hb,-0.015,"b");text(hc,-0.015,"c");text(hd,-0.015,"d");text(he,-0.015,"e");text(hf,-0.015,"f");text(h0,-0.015,"g")
# CI for all, me
lines(c(h0,h0),prop.test(x=c(T1[1,1],T1[3,1]),n=c(sum(T1[1,]),sum(T1[3,])))$conf.int,col="grey")
# 3 CIs for a
lines(c(ha1,ha1),Ta1$conf.int,col="grey");lines(c(ha2,ha2),Ta2$conf.int,col="grey")
lines(c(ha3,ha3),Ta3$conf.int,col="grey")
# 2 CIs for b 
lines(c(hb+1,hb+1),prop.test(x=c(f1ug,f1ul),n=c(277,276))$conf.int,col="grey")
lines(c(hb-1,hb-1),prop.test(x=c(f1ng,f1nl),n=c(278,279))$conf.int,col="grey")
# 2 CIs for c
lines(c(hc-1,hc-1),prop.test(x=c(f2ag,f2al),n=c(181,181))$conf.int,col="grey")
lines(c(hc+1,hc+1),prop.test(x=c(f2bg,f2bl),n=c(191,190))$conf.int,col="grey")
# 2 CIs for d
lines(c(hd-1,hd-1),prop.test(x=c(f3hg,f3hl),n=c(nhg,nhl))$conf.int,col="grey")
lines(c(hd+1,hd+1),prop.test(x=c(f3eg,f3el),n=c(neg,nel))$conf.int,col="grey")
# CI for e
lines(c(he,he),prop.test(x=c(T4[1],T4[3]),n=c(sum(T4[1:2]),sum(T4[3:4])),conf.level=0.95)$conf.int,col="grey")
# CI for f
lines(c(hf,hf),prop.test(x=c(T6[2],T6[4]),n=c(sum(T6[1:2]),sum(T6[3:4])),conf.level=0.95)$conf.int,col="grey")
@
\title{\small{\sffamily{Each data point shows effect size (difference in proportions selecting the certain option for gains and losses frames) for a replication of the ADE, with an associated 95-percent-confidence interval. Studies producing the replication are labelled with letters, matched to articles in Table ~\ref{fig:reptraits} and in the Sources. ``ML95CI'' shows the 95-percent confidence interval for effect size from the 2014 ``many-labs'' replication. ``TK'' marks this effect size in the original Tversky-Kahneman study. }}}
\end{figure}

\begin{table}[ht]
\centering
\caption{Some Details of Pandemic ADE Replications}
\label{fig:reptraits}
\begin{tabular}{lrrrrrr}
  \hline
  source & N & subject population &  risk & expected loss  \\ 
  \hline
  a. Wolaver \& Doces & 252 & US           & rare disease  & 600   \\
  \;& 253 & US           & terrorism     & 600   \\ 
  \;& 1199 & US           & rare disease  & 600   \\ 
  b. Hameleers & 553 & US           & coronavirus  \\
  \;& 557 & Netherlands  & coronavirus   & na \\ 
  c. Otterbeing et al. & 362 & OECD countries* & Asian disease & 600   \\ 
  \; & 381 & OECD countries* & Covid-19      & 600   \\ 
  d. Olmastroni et al. & 785 & Italy         & coronavirus  &30,000 \\ 
  \; & 777 & Italy         & coronavirus  &600,000 jobs \\ 
  e. Rachev et al. & 88,181  & 47 countries  & unusual disease & 600  \\ 
  f. Im \& Chen & 102,830 & 49 countries  & unusual disease & 600 &  \\ 
  g. Gaines & 990    & US            & pandemic & 600 (per week)  \\    \hline
\end{tabular}
\end{table}

\end{document}
